home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0152_Infix to Postfix expression parser #2.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.6 KB  |  149 lines
  1. {
  2. >      Is there a standard of "best" algorithm used to convert algebraic format
  3. > statements, such as a Pascal assignment statement, to a postfix format, such
  4. > as usually used inside the compiler in preparation to generating machine
  5. > language object file?
  6.  
  7. >      Or, to put it another way, what is the best know way to convert
  8. >           X := 4*(Lastval + Curval)/3.0;
  9. >      to
  10. >           Lastval, Curval + 4 * 3.0 /
  11. >       ?
  12. >                                        Joel Lichtenwalner
  13.  
  14.  
  15. I don't know about the best or standard, but I recently wrote a procedure
  16. that does this without using any recursion or stacks. OK, it uses a few
  17. array's to hold few WORD's.
  18.  
  19. What's nice about it is that it allows for only 4 temperary values to be
  20. stored, which can be expanded to mean AX,BX,CX and DX. (You can increase this
  21. to whatever you want) What's even nicer is that I have not been able to
  22. write an infix expression complex enough to use more than 2 of the 4
  23. temperary variables! It's very short, so I added it to the message (you may
  24. flame me with your newest gem ... :)
  25. {-----------------------------------------------------------------------}
  26.  
  27. const
  28.  
  29.    OpChars = ['+','-','/','*']; {These two sets must be mutually exclusive}
  30.  
  31.    SymbolChars=['a'..'z','A'..'Z','0'..'9','.','_'];
  32.  
  33.  
  34.  
  35. const
  36.  
  37.    TempVars:string='adcb';{The 4 temporary variables (or registers)}
  38.  
  39. function GetTempResult(s:string):char;
  40. {Returns the best place to store the temporary result}
  41.    var n,c:integer; p:array[1..5] of byte;
  42.    begin
  43.       c:=0;
  44.       for n:=1 to length(s) do if s[n] in ['a'..'d'] then begin
  45.          inc(c);
  46.          p[c]:=n;
  47.       end;
  48.       case c of
  49.          0:begin
  50.             GetTempResult:=TempVars[1];
  51.             delete(TempVars,1,1);
  52.          end;
  53.          1:GetTempResult:=s[p[1]];
  54.          else begin
  55.             for n:=2 to c do TempVars:=s[p[n]]+TempVars;
  56.             GetTempResult:=s[p[1]];
  57.          end;
  58.       end;
  59.    end;
  60.  
  61. function Priority(s:string):byte;
  62. {Returns the oprator's priority}
  63.    begin
  64.       if length(s)=1 then
  65.          case s[1] of
  66.             '+','-':Priority:=0;
  67.             '*','/':Priority:=1;
  68.          end
  69.       else;
  70.    end;
  71.  
  72. procedure Error(S:string);
  73. {Reports an error}
  74.    begin
  75.       writeln(';***Error***: ',S);
  76.       Halt;
  77.    end;
  78.  
  79. function PostFix(InFix:string):string;
  80.    var
  81.       Ops:array[1..255] of byte;{Allows only <=255 operators in one...}
  82.       Pri:array[1..255] of word;{...expression}
  83.       OC,n,L,R,Shell,MaxOp:integer;
  84.       LS,Op,RS:string;
  85.    begin
  86.       OC:=0;
  87.       Shell:=0;
  88.       MaxOp:=1;
  89.       n:=1;
  90.       while n<=length(InFix) do begin
  91.          if Infix[n] in OpChars then begin
  92.             R:=n;
  93.             while (R<length(InFix)) and (InFix[R] in OpChars) do inc(R);
  94.             Op:=copy(InFix,n,R-n);
  95.             inc(OC);
  96.             Ops[OC]:=n;
  97.             Pri[OC]:=Priority(Op)+Shell;
  98.             if Pri[OC]>=Pri[MaxOp] then MaxOp:=OC;
  99.             n:=R-1;
  100.          end else
  101.          case InFix[n] of
  102.             '(':inc(Shell,100);{Allows for 100 levels of priorities...}
  103.             ')':dec(Shell,100);{...for operators}
  104.          end;
  105.          inc(n);
  106.        end;
  107.        if Shell>0 then Error('Too few ")".');{Although I report this errors...}
  108.        if Shell<0 then Error('Too few "(".');{... the procedure still works...}
  109.                                              {...if you don't}
  110.        while OC>0 do begin
  111.           n:=Ops[MaxOp]-1;  {Read Left Parameter}
  112.           while (n>0) and not(InFix[n] in SymbolChars) do dec(n);
  113.           L:=n;
  114.           while (L>0) and (InFix[L] in SymbolChars) do dec(L);
  115.           LS:=copy(InFix,L+1,n-L);
  116.  
  117.           n:=Ops[MaxOp]+1; {Read Right Paramter}
  118.           while (n<=length(InFix)) and not(InFix[n] in SymbolChars) do inc(n);
  119.           R:=n;
  120.           while (R<=length(InFix)) and (InFix[R] in SymbolChars) do inc(R);
  121.           RS:=copy(InFix,n,R-n);
  122.           {PS. Only allows for 2 parameter ops.}
  123.  
  124.           Op:=GetTempResult(LS+RS);
  125.           writeln(LS,RS,InFix[Ops[MaxOp]],' -> ',Op);
  126.  
  127.           InFix[L+1]:=Op[1]; InFix[L+2]:=' ';
  128.           InFix[R-1]:=Op[1]; InFix[R-2]:=' ';
  129.  
  130.           dec(OC);
  131.           for n:=MaxOp to OC do begin
  132.              Pri[n]:=Pri[n+1];
  133.              Ops[n]:=Ops[n+1];
  134.           end;
  135.           if MaxOp>OC then dec(MaxOp);
  136.           while (MaxOp>1) and (Pri[MaxOp-1]>Pri[MaxOp]) do dec(MaxOp);
  137.        end;
  138.        PostFix:=Op;
  139.     end;
  140.  
  141.  
  142.  var Infix:string;
  143.  begin
  144.     Infix:='(A+B)+(B/B+A*(C-D)+(E-F*G+H))';
  145.     writeln(InFix);
  146.     writeln(PostFix(InFix));
  147.     readln;
  148.  end.
  149.